;; Mode: LISP; Syntax: Common-lisp; Package: aklemme                           
;; Names: Ardell Klemme, Bruce Ho, Jimmy Cumming         Date: 11/15/12                    
;; Course: ICS 313   Assignment: 6                                         
;; File: Assignment6.lisp

;; AK: Comment Heuristics :
;;      - Be sure to include initials at the beginning of comments.
;;      - Be sure to comment only on code which you have modified.
;;      - Always add comments, never remove another person's comments.

; AK: Contains code from Land of Lisp Book and from my previous work

;JC
;this prevents Allegro from chopping off messages                               
;printed by our text adventure game      
(setf tpl:*print-length* nil)

; AK: defines nodes that contain locations and descriptions                          
(defparameter *nodes* '((main-room (Welcome! you are in the control center
                            where you control all the systems. There's been damaged
         to the enterprise and it needs repair. You must talk with your crewmates to 
                          find out where the issue is.))
                        (engine-room (this talks with the engine room.
                            check the systems.))
                        (armory (talk with the weapons room.
                            check the weapons.))))
; AK: describes description associated with location parameter                       
(defun describe-location (location nodes)
   (cadr (assoc location nodes)))
; AK: defines list of edges at each location and their direction/path
(defparameter *edges* '((main-room (engine-room west screen)
                                     (armory north screen))
                        (engine-room (main-room east screen))))
; AK: describes path and direction for each edge                                     
(defun describe-path (edge)
  `(there is a ,(caddr edge) going ,(cadr edge) from here.))

; AK: describes paths available from this location                                   
(defun describe-paths (location edges)
  (apply #'append (mapcar #'describe-path (cdr (assoc location edges)))))

; AK: defines all objects in the game.                                               
(defparameter *objects* '(whiskey bucket frog chain scabbard blade hilt
                          crossguard stone-of-power))

; AK: define multi-part object - the sword of omens here.                            
(defparameter *multi-part-obj* '(sword-of-omens
                                 (blade hilt crossguard stone-of-power)))

; AK: defines all object location associations.
(defparameter *object-locations* '((whiskey living-room)
                                   (bucket living-room)
                                   (chain garden)
                                   (frog garden)
                                   (scabbard armory)
                                   ; AK: place sword-of-omen pieces in world         
                                   (blade attic)
                                   (hilt living-room)
                                   (crossguard armory)
                                   (stone-of-power garden)))

; AK: shows only objects at location                                                 
(defun objects-at (loc objs obj-loc)
   (labels ((is-at (obj)
              (eq (cadr (assoc obj obj-loc)) loc)))
       (remove-if-not #'is-at objs)))

; AK: describes objects in current location                                          
(defun describe-objects (loc objs obj-loc)
   (labels ((describe-obj (obj)
                `(you see a ,obj on the floor.)))
      (apply #'append (mapcar #'describe-obj (objects-at loc objs obj-loc)))))

; AK: set default location to living-room              
(defparameter *location* 'living-room)

; AK: displays current location and information about location, paths available      
;     and objects in current location                                                
(defun look ()
  (append (describe-location *location* *nodes*)
          (describe-paths *location* *edges*)
          (describe-objects *location* *objects* *object-locations*)))
          
; AK: walks in given direction, if it is a valid direction, else give error msg.
; AK: this now handles the command when no arguments are given
(defun walk (&optional (direction "nowhere"))
  (cond ((equal direction "nowhere")
         `(you must specify which direction to go.))
   (t
    (labels ((correct-way (edge)
             (eq (cadr edge) direction)))
    (let ((next (find-if #'correct-way (cdr (assoc *location* *edges*)))))
      (if next
          (progn (setf *location* (car next))
                 (look))
          '(you cannot go that way.)))))))

; AK: picks up an object if it exists in current location, puts onto body            
;     (inventory). 
; AK: This now handles the command without arguments                                                                    
(defun pickup (&optional (object "nothing"))
  (cond ((equal object "nothing")
         `(you must specify something to pickup.))
        ((member object
                 (objects-at *location* *objects* *object-locations*))
         (push (list object 'body) *object-locations*)
          `(you are now carrying the ,object))
        (t '(you cannot get that.))))

; AK: lists all objects in inventory                                                 
(defun inventory ()
  (cons 'items- (objects-at 'body *objects* *object-locations*)))

; AK: checks inventory for a specific object, returns t/nil                          
(defun have (object)
    (member object (cdr (inventory))))
    
; AK: help function - print available commands                                  
(defun help ()
  `(you can use one of the following commands- ,@*allowed-commands*))

; AK: alias to help, just lets user call help with "h" instead                  
(defun h ()
  (help))




;JC This is a function from Dr. Reed's samples
(defun our-member (obj lst)
  (if (null lst)
      nil
      (if (eql (caar lst) obj)
          t
          (our-member obj (cdr lst)))))


;JC This is a function from Dr. Reed's samples
;modified for objects
(defun our-member-obj (obj lst)
  (if (null lst)
      nil
      (if (eql (car lst) obj)
          t
          (our-member-obj obj (cdr lst)))))


;;;=========================R-E-P-L=======================;;;
; AK: custom read-eval-print-loop                                                    
; AK: recursively calls repl unless user exits with 'quit command.                   
(defun game-repl ()
    (let ((cmd (game-read)))
        (unless (eq (car cmd) 'quit)
            (game-print (game-eval cmd))
            (game-repl))))

; AK: custom read function takes string arguments and adds parenthesis around it     
;     and adds quote for function command.                                           
(defun game-read ()
    (let ((cmd (read-from-string (concatenate 'string "(" (read-line) ")"))))
         ; AK: function adds quote to data portion of command string                 
         (flet ((quote-it (x)
                    (list 'quote x)))
             (cons (car cmd) (mapcar #'quote-it (cdr cmd))))))

; AK: defines available input from user such that users cannot "hack" the game.      
(defparameter *allowed-commands* '(look walk pickup inventory help h))

; AK: limits available input from user                                               
(defun game-eval (sexp)
    (if (member (car sexp) *allowed-commands*)
        (eval sexp)
        '(i do not know that command.)))

; AK: capitalize first letter of each sentence                                       
(defun tweak-text (lst caps lit)
  (when lst
    (let ((item (car lst))
          (rest (cdr lst)))
      (cond ((eql item #\space) (cons item (tweak-text rest caps lit)))
            ((member item '(#\! #\? #\.)) (cons item (tweak-text rest t lit)))
            ((eql item #\") (tweak-text rest caps (not lit)))
            (lit (cons item (tweak-text rest nil lit)))
            (caps (cons (char-upcase item) (tweak-text rest nil lit)))
            (t (cons (char-downcase item) (tweak-text rest nil nil)))))))

; AK: custom print function to handle output from interface.                         
(defun game-print (lst)
    (princ (coerce (tweak-text (coerce (string-trim "() "
                                                     (prin1-to-string lst))
                                       'list)
                               t nil)
                   'string))
    (fresh-line))

;;;==========================Macros===============================;;;           

; AK: For the next project, we'll put these in another lisp file                

; AK: macro for new objects, need to push to *objects* and                      
;     to the *object-location*                                                  
(defmacro new-object (name location)
  `(progn
     (cond
       ((and 
          (not (our-member-obj ',name *objects*))
          (our-member ',location *nodes*))
        (pushnew ',name *objects*)
        (pushnew '(,name ,location) *object-locations*))
       (t "Object already exists"))))

; AK: test: add new object pillow to living-room                                
(new-object pillow living-room)

; AK: Main macro for the new locations in game. We need to push a               
;     new node with name and description.                                       
(defmacro new-location (name &body body)
  `(cond
   ((not (our-member ',name *nodes*))
    (pushnew '(,name (,@body)) *nodes*))
   (t "Location already exists")))

; AK: Adding a few new locations in to test                                     
(new-location armory you are in an armory.
              you see weapons hanging on the walls.
              you also see a forge in the middle of the room.)

(new-location lanai you are on the lanai. you can see the garden below.)


; AK: This is the main macro for setting up new actions in game.
;     Basically, the parameters are straight forward and this makes it
;     easy to add new actions/commands to the game.
(defmacro game-action (command subj obj place &body body)
  `(progn (defun ,command (subject object)
            (if (and (eq *location* ',place)
                     (eq subject ',subj)
                     (eq object ',obj)
                     (have ',subj))
                ,@body
              '(i cant ,command like that.)))
          (pushnew ',command *allowed-commands*)))

; AK: New implementation of new-path macro
;     We only need the following args:
;     origin, destination, direction, path
;     Optional arg: direction-back
(defmacro new-path (origin destination direction path &optional (direction-back "unable"))
  `(cond
    ((or
      ; case 1:origin doesn't exist                                             
      (not (our-member ',origin *nodes*))
      ; case 2:destination doesn't exist                                        
      (not (our-member ',destination *nodes*)))
     ()"Missing location, cannot create path.")
     ; case 3:okay to implement                                                 
    (t(progn
        (if (equal ',direction-back "unable")
            nil
          ;now we need to test to see if the destination is already there       
          (cond
           ((our-member ',destination *edges*)
            (pushnew '(,origin ,direction-back ,path)
                 (cdr (assoc ',destination *edges*))))
           (t (pushnew '(,destination
                          (,origin ,direction-back ,path)) *edges*))))
          ; add new location/direction/path to origin's list of edges           
        (pushnew '(,destination ,direction ,path)
                 (cdr (assoc ',origin *edges*)))))))

; AK: We want to default the state of the bucket to unwelded
(defparameter *chain-welded* nil)

; AK: Now we can go in and set the dependencies for bucket to be welded
;     Must have the chain and bucket and be in the attic, and must
;     be trying to use the weld command.
(game-action weld chain bucket attic
             (if (and (have 'bucket) (not *chain-welded*))
                 (progn (setf *chain-welded* 't)
                        '(the chain is now securely welded to the bucket.))
               '(you do not have a bucket.)))

; AK: We start with the bucket not having any water in it
(defparameter *bucket-filled* nil)

; AK: Now we can create the dunk action and allow the bucket
;     to be filled for splashing on the Wizard.
(game-action dunk bucket well garden
             (if *chain-welded*
                 (progn (setf *bucket-filled* 't)
                        '(the bucket is now full of water))
               '(the water level is too low to reach.)))

; AK: This is the final action for splashing the Wizard in the face with
;     cold water and waking him up.
(game-action splash bucket wizard living-room
             (cond ((not *bucket-filled*) '(the bucket has nothing in it.))
                   ((have 'frog)
                    '(the wizard awakens and sees that you stole his frog.
                          he is so upset he banishes you to the
                          netherworlds- you lose! the end.))
                   (t
                    '(the wizard awakens from his slumber and greets you
                          warmly. he hands you the magic low-carb donut
                          - you win! the end.))))

; AK: Again, starting with an unforged sword, forge action needs to be
;     generated.
(defparameter *sword-forged* nil)
    
; AK: This is the action to forge the Sword of Omens.
; AK: Jimmy/Bruce, this action could be updated to better work with the
;     multi-part-object.  Feel free to change this.
(game-action forge blade hilt armory
             (cond ((not (have 'stone-of-power)) 
                    '(you're missing the stone of power.))
                   ((not (have 'crossguard))
                    '(you're missing the crossguard.))
                   ((equal *sword-forged* t)
                    '(the sword of omens is already forged.))
                    (t (progn
                         (setf *sword-forged* 't)
                         (new-object sword-of-omens armory)
                         (setf *objects*
                               (remove 'blade *objects*))
                         (setf *objects*
                               (remove 'hilt *objects*))
                         (setf *objects*
                               (remove 'crossguard *objects*))
                         (setf *objects*
                               (remove 'stone-of-power *objects*))
                         (pickup 'sword-of-omens)
                         '(you have successfully forged the sword of omens.)))))